(SETQ IBASE (ADD1 7)) 


(DEFPROP ALLFNS 
 (NIL SETDIF
      FUCK
      ONCEFLATEXPR
      FLATTEN
      HIDDEN-LINE
      LSP
      ORG
      SIZ
      VSUB
      DIT
      MIDIT
      PLOT-VECTOR
      TWO-POLY-WITH-COMMON-EDGE
      SET-INTERSECTION
      FORM-NEW-EDGE
      ENDPOINTS
      TWO-INTERSECTING-PLANES?
      FIXVEC
      ARDS-VECTOR
      ARDSHI
      ARDSLO
      DELETE
      LISTASSOC
      ORDLOW
      ONCEONLY
      XXXXXX
      DOTS
      III
      PLOT
      ARDS
      VECTOR
      DATA
      INITPOLY
      INITIALIZE-PLANE-OF-POLYGON-PROPERTIES
      KRAMER
      DETMAT
      DETM
      INITIALIZE-CIRCUMSCRIBED-RECTANGLE-PROPERTY
      ENDS-PROPERTY
      WARNOCK
      OUTSIDE
      MAPPENDCAR
      MAPPENDLIST
      DIW-PROPERTY
      EXTREMA
      MOST
      *MOST
      LEAST
      *LEAST
      ZDEPTH
      SURROUND
      SURROUNDS-WINDOW?
      IS-WINDOW-SURROUNDED-BY-CIRCUMSCRIBED-RECTANGLE?
      IS-EACH-CORNER-OF-WINDOW-WITHIN-THE-POLYGON?
      SPLIT-POLYGON-INTO-TRIANGLES
      CORNER-WITHIN-ANY-TRIANGLE?
      CORNER-WITHIN-TRIANGLE?
      POINT-AND-ODD-VERTEX-IN-SAME-HALF-PLANE?
      MMMM
      MMM
      HIDE
      NIL-BEYOND-DEPTH-BOUND
      ABOVE
      CLIP
      CLIP2
      SPLICE1
      SPLICE2
      SUPERSPLICE1
      SUPERSPLICE2
      SAMEPOINT?
      CLIP-LINE-SEGMENT
      ENDPOINTS-WITHIN-WINDOW?
      ENDPOINTS-BEYOND-WINDOW?
      GREATERPEQ
      CHEAP-SPLICE
      MIDPOINT
      TRIVAIL
      SIMPLE?
      SMALL?
      UNRESOLVED
      SPLITUP
      SAFE
      TEST2) 
VALUE)

(DEFPROP SETDIF 
 (LAMBDA (A B) (COND ((NULL A) B) (T (SETDIF (CDR A) (DELETE (CAR A) B))))) 
EXPR)

(DEFPROP FUCK 
 (LAMBDA (Z) (SET-INTERSECTION ALLFNS (ONCEFLATEXPR Z))) 
EXPR)

(DEFPROP ONCEFLATEXPR 
 (LAMBDA (Z) (ONCEONLY (FLATTEN (GET Z (QUOTE EXPR))))) 
EXPR)

(DEFPROP FLATTEN 
 (LAMBDA (Z) (COND ((NULL Z) NIL) ((ATOM Z) (LIST Z)) (T (APPEND (FLATTEN (CAR Z)) (FLATTEN (CDR Z)))))) 
EXPR)

(DEFPROP HIDDEN-LINE 
 (LAMBDA(VIEWNAME POLYGON-LIST)
  (PROG NIL
	(MAPC (FUNCTION INITPOLY) POLYGON-LIST)
	(WARNOCK POLYGON-LIST NIL -512.0 512.0 -512.0 512.0)
	(MAPC (FUNCTION SUPERSPLICE2) POLYGON-LIST)
	(MAPC (FUNCTION SUPERSPLICE1) POLYGON-LIST))) 
EXPR)

(DEFPROP LSP 
 (LAMBDA(Z)
  (COND ((ATOM (CAR Z))
	 (PROG (TEM Y TPEN)
	       (SETQ TEM ORG)
	       (SETQ Y (COND ((SETQ TPEN (ATOM (CDR Z))) (CDR Z)) (T (CADR Z))))
	       (SETQ ORG (CONS (PLUS (TIMES SIZ (CAR Z)) (CAR ORG)) (PLUS (TIMES SIZ Y) (CDR ORG))))
	       (OUTC T NIL)
	       (COND ((NOT (EQ PEN TPEN)) (COND ((SETQ PEN TPEN) (DIT 17 20)) (T (DIT 20 40)))))
	       (MIDIT (TIMES SIZ (CAR Z)) (TIMES SIZ Y))
	       (OUTC NIL NIL)
	       (RETURN ORG)))
	(T (PROG2 (LSP (LIST (CAAR Z) (CDAR Z))) (LSP (CDR Z)))))) 
EXPR)

(DEFPROP ORG 
 (NIL 0 . 220) 
VALUE)

(DEFPROP ORG 
 T 
SPECIAL)

(DEFPROP SIZ 
 (NIL . 1) 
VALUE)

(DEFPROP SIZ 
 T 
SPECIAL)

(DEFPROP VSUB 
 (LAMBDA (P2 P3) (CONS (DIFFERENCE (CAR P2) (CAR P3)) (DIFFERENCE (CDR P2) (CDR P3)))) 
EXPR)

(DEFPROP DIT 
 (LAMBDA (N X) (PROG NIL L (COND ((ZEROP N) (RETURN NIL))) (TYO X) (SETQ N (SUB1 N)) (GO L))) 
EXPR)

(DEFPROP MIDIT 
 (LAMBDA(X Y)
  (COND ((ZEROP X) (DIT (ABS Y) (COND ((MINUSP Y) 10) (T 4))))
	((ZEROP Y) (DIT (ABS X) (COND ((MINUSP X) 2) (T 1))))
	((EQ (ABS X) (ABS Y))
	 (DIT (ABS X) (PLUS 100 (COND ((MINUSP X) 2) (T 1)) (COND ((MINUSP Y) 10) (T 4)))))
	(T
	 (PROG2 (MIDIT (QUOTIENT X 2) (QUOTIENT Y 2))
		(MIDIT (DIFFERENCE X (QUOTIENT X 2)) (DIFFERENCE Y (QUOTIENT Y 2))))))) 
EXPR)

(DEFPROP PLOT-VECTOR 
 (LAMBDA(V)
  (PROG NIL (LSP (LIST (CAR (VSUB (CAR V) ORG)) (CDR (VSUB (CAR V) ORG)))) (LSP (VSUB (CDR V) (CAR V))))) 
EXPR)

(DEFPROP TWO-POLY-WITH-COMMON-EDGE 
 (LAMBDA NIL
  (AND (EQUAL 2 (LENGTH ABOVE-LIST))
       (GREATERP 2 (LENGTH SURROUNDERS-LIST))
       (EQUAL ABOVE-LIST POLYGON-LIST)
       (EQUAL 1
	      (LENGTH
	       (SET-INTERSECTION (GET (CAR ABOVE-LIST) (QUOTE EDGES))
				 (GET (CADR ABOVE-LIST) (QUOTE EDGES))))))) 
EXPR)

(DEFPROP SET-INTERSECTION 
 (LAMBDA(A B)
  (PROG (Z1 Z2)
	(SETQ Z1 A)
	(SETQ Z2 NIL)
   L    (COND ((NULL Z1) (RETURN Z2)))
	(COND ((MEMBER (CAR Z1) B) (SETQ Z2 (CONS (CAR Z1) Z2))))
	(SETQ Z1 (CDR Z1))
	(GO L))) 
EXPR)

(DEFPROP FORM-NEW-EDGE 
 (LAMBDA NIL
  (PROG (POLY1 POLY2 EDGE)
	(SETQ POLY1 (CAR SURROUNDERS-LIST))
	(SETQ POLY2 (CADR SURROUNDERS-LIST))
	(SETQ EDGE (SET-INTERSECTION (GET POLY1 (QUOTE EDGEZ)) (GET POLY2 (QUOTE EDGEZ))))
	(SETQ POLYGON-LIST (CDR SURROUNDERS-LIST))
	(COND ((NOT (NULL EDGE)) (CLIP2) (RETURN NIL)))
	(SETQ EDGE (GENSYM))
	(PUTPROP POLY1 (CONS EDGE (GET POLY1 (QUOTE EDGEZ))) (QUOTE EDGEZ))
	(PUTPROP POLY2 (CONS EDGE (GET POLY2 (QUOTE EDGEZ))) (QUOTE EDGEZ))
	(PUTPROP EDGE (ENDPOINTS POLY1 POLY2) (QUOTE ENDS))
	(CLIP2))) 
EXPR)

(DEFPROP ENDPOINTS 
 (LAMBDA(POLY1 POLY2)
  (PROG (A1 B1 C1 A2 B2 C2 M B K)
	(SETQ A1 (GET POLY1 (QUOTE A)))
	(SETQ B1 (GET POLY1 (QUOTE B)))
	(SETQ C1 (GET POLY1 (QUOTE C)))
	(SETQ A2 (GET POLY2 (QUOTE A)))
	(SETQ B2 (GET POLY2 (QUOTE B)))
	(SETQ C2 (GET POLY2 (QUOTE C)))
	(SETQ M (DIFFERENCE (QUOTIENT A1 C1) (QUOTIENT A2 C2)))
	(SETQ B (DIFFERENCE (QUOTIENT B1 C1) (QUOTIENT B2 C2)))
	(SETQ K (DIFFERENCE (QUOTIENT 100.0 C1) (QUOTIENT 100.0 C2)))
	(COND ((GREATERP (ABS M) (ABS B))
	       (RETURN
		(CONS (CONS (QUOTIENT (DIFFERENCE K (TIMES B 511.0)) M) 511.0)
		      (CONS (QUOTIENT (DIFFERENCE K (TIMES B -511.0)) M) -511.0))))
	      (T
	       (RETURN
		(CONS (CONS 511.0 (QUOTIENT (DIFFERENCE K (TIMES M 511.0)) B))
		      (CONS -511.0 (QUOTIENT (DIFFERENCE K (TIMES M -511.0)) B)))))))) 
EXPR)

(DEFPROP TWO-INTERSECTING-PLANES? 
 (LAMBDA NIL (AND (NULL POLYGON-LIST) (EQUAL 2 (LENGTH SURROUNDERS-LIST)))) 
EXPR)

(DEFPROP FIXVEC 
 (LAMBDA (V) (CONS (CONS (FIX (CAAR V)) (FIX (CDAR V))) (CONS (FIX (CADR V)) (FIX (CDDR V))))) 
EXPR)

(DEFPROP ARDS-VECTOR 
 (LAMBDA(V)
  (PROG NIL
	(TYO 35)
	(TYO (ARDSLO (CAAR V)))
	(TYO (ARDSHI (CAAR V)))
	(TYO (ARDSLO (CDAR V)))
	(TYO (ARDSHI (CDAR V)))
	(TYO 36)
	(TYO (ARDSLO (DIFFERENCE (CADR V) (CAAR V))))
	(TYO (ARDSHI (DIFFERENCE (CADR V) (CAAR V))))
	(TYO (ARDSLO (DIFFERENCE (CDDR V) (CDAR V))))
	(TYO (ARDSHI (DIFFERENCE (CDDR V) (CDAR V)))))) 
EXPR)

(DEFPROP ARDSHI 
 (LAMBDA (X) (BOOLE 1 137 (PLUS 100 (QUOTIENT (ABS X) 40)))) 
EXPR)

(DEFPROP ARDSLO 
 (LAMBDA (X) (BOOLE 1 177 (PLUS 100 (TIMES 2 (REMAINDER (ABS X) 40)) (COND ((MINUSP X) 1) (T 0))))) 
EXPR)

(DEFPROP DELETE 
 (LAMBDA(A Z)
  (COND ((NULL Z) NIL) (T (APPEND (COND ((EQ A (CAR Z)) NIL) (T (NCONS (CAR Z)))) (DELETE A (CDR Z)))))) 
EXPR)

(DEFPROP LISTASSOC 
 (LAMBDA (Z) (MAPPENDCAR (FUNCTION (LAMBDA (A) (LIST (CAAR A) A))) Z)) 
EXPR)

(DEFPROP ORDLOW 
 (LAMBDA (Z) (COND ((GREATERP (CAAR Z) (CADR Z)) (CONS (CDR Z) (CAR Z))) (T Z))) 
EXPR)

(DEFPROP ONCEONLY 
 (LAMBDA(Z)
  (PROG (A B)
	(SETQ A Z)
	(SETQ B NIL)
   L    (COND ((NULL A) (RETURN (REVERSE B))))
	(COND ((NOT (MEMBER (CAR A) (CDR A))) (SETQ B (CONS (CAR A) B))))
	(SETQ A (CDR A))
	(GO L))) 
EXPR)

(DEFPROP XXXXXX 
 (LAMBDA (A B) (COND ((NULL A) B) (T (CONS A B)))) 
EXPR)

(DEFPROP DOTS 
 (LAMBDA (Z) (COND ((NULL Z) NIL) (T (APT (FIX (CAAR Z)) (FIX (CDAR Z))) (DOTS (CDR Z))))) 
EXPR)

(DEFPROP III 
 (LAMBDA(POLY)
  (MAPC (FUNCTION
	 (LAMBDA(EDGE)
	  (MAPC (FUNCTION (LAMBDA (LINE) (PROG2 (VECTOR (FIXVEC LINE)) (SHOW 0)))) (GET EDGE VIEWNAME))))
	(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES))))) 
EXPR)

(DEFPROP PLOT 
 (LAMBDA(POLY)
  (MAPC (FUNCTION
	 (LAMBDA (EDGE) (MAPC (FUNCTION (LAMBDA (LINE) (PLOT-VECTOR (FIXVEC LINE)))) (GET EDGE VIEWNAME))))
	(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES))))) 
EXPR)

(DEFPROP ARDS 
 (LAMBDA(POLY)
  (MAPC (FUNCTION
	 (LAMBDA (EDGE) (MAPC (FUNCTION (LAMBDA (LINE) (ARDS-VECTOR (FIXVEC LINE)))) (GET EDGE VIEWNAME))))
	(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES))))) 
EXPR)

(DEFPROP VECTOR 
 (LAMBDA (V) (PROG2 (AIVECT (FIX (CAAR V)) (FIX (CDAR V))) (AVECT (FIX (CADR V)) (FIX (CDDR V))))) 
EXPR)

(DEFPROP DATA 
 (LAMBDA NIL
  (PROG NIL
	(SETQ VIEWNAME (QUOTE VIEW))
	(DEFPROP I1 (300 300 300) IMAGE)
	(DEFPROP J1 (-300 300 300) IMAGE)
	(DEFPROP K1 (-300 -300 300) IMAGE)
	(DEFPROP L1 (300 -300 300) IMAGE)
	(DEFPROP I2 (100 100 40) IMAGE)
	(DEFPROP J2 (100 -500 40) IMAGE)
	(DEFPROP K2 (-500 -500 700) IMAGE)
	(DEFPROP L2 (-500 100 700) IMAGE)
	(DEFPROP IJ1 (I1 . J1) POINTS)
	(DEFPROP JK1 (J1 . K1) POINTS)
	(DEFPROP KL1 (K1 . L1) POINTS)
	(DEFPROP LI1 (L1 . I1) POINTS)
	(DEFPROP IJ2 (I2 . J2) POINTS)
	(DEFPROP JK2 (J2 . K2) POINTS)
	(DEFPROP KL2 (K2 . L2) POINTS)
	(DEFPROP LI2 (L2 . I2) POINTS)
	(DEFPROP RR1 (IJ1 JK1 KL1 LI1) EDGES)
	(DEFPROP RR1 (I1 J1 K1 L1) CORNERS)
	(DEFPROP RR2 (IJ2 JK2 KL2 LI2) EDGES)
	(DEFPROP RR2 (I2 J2 K2 L2) CORNERS))) 
EXPR)

(DEFPROP INITPOLY 
 (LAMBDA(POLY)
  (PROG NIL
	(SETQ INTER NIL)
	(SETQ UNRES NIL)
	(INITIALIZE-PLANE-OF-POLYGON-PROPERTIES POLY)
	(INITIALIZE-CIRCUMSCRIBED-RECTANGLE-PROPERTY POLY)
	(ENDS-PROPERTY POLY))) 
EXPR)

(DEFPROP INITIALIZE-PLANE-OF-POLYGON-PROPERTIES 
 (LAMBDA(POLYGON)
  (PROG (A B C)
	(SETQ C (GET POLYGON (QUOTE CORNERS)))
	(SETQ A (GET (CAR C) (QUOTE IMAGE)))
	(SETQ B (GET (CADR C) (QUOTE IMAGE)))
	(SETQ C (GET (CADDR C) (QUOTE IMAGE)))
	(SETQ A (KRAMER A B C))
	(PUTPROP POLYGON (CAR A) (QUOTE A))
	(PUTPROP POLYGON (CADR A) (QUOTE B))
	(PUTPROP POLYGON (CADDR A) (QUOTE C)))) 
EXPR)

(DEFPROP KRAMER 
 (LAMBDA(A B C)
  (PROG (XS YS ZS DENOM KVEC)
	(SETQ XS (LIST (CAR A) (CAR B) (CAR C)))
	(SETQ YS (LIST (CADR A) (CADR B) (CADR C)))
	(SETQ ZS (LIST (CADDR A) (CADDR B) (CADDR C)))
	(SETQ DENOM (DETMAT XS YS ZS))
	(SETQ KVEC (LIST 100.0 100.0 100.0))
	(RETURN
	 (LIST (QUOTIENT (DETMAT KVEC YS ZS) DENOM)
	       (QUOTIENT (DETMAT XS KVEC ZS) DENOM)
	       (QUOTIENT (DETMAT XS YS KVEC) DENOM))))) 
EXPR)

(DEFPROP DETMAT 
 (LAMBDA (D E F) (DETM (CAR D) (CAR E) (CAR F) (CADR D) (CADR E) (CADR F) (CADDR D) (CADDR E) (CADDR F))) 
EXPR)

(DEFPROP DETM 
 (LAMBDA(A11 A12 A13 A21 A22 A23 A31 A32 A33)
  (PLUS (TIMES A11 (DIFFERENCE (TIMES A22 A33) (TIMES A23 A32) 0.0))
	(TIMES (MINUS A12) (DIFFERENCE (TIMES A21 A33) (TIMES A23 A31)))
	(TIMES A13 (DIFFERENCE (TIMES A21 A32) (TIMES A22 A31))))) 
EXPR)

(DEFPROP INITIALIZE-CIRCUMSCRIBED-RECTANGLE-PROPERTY 
 (LAMBDA(POLYGON)
  (PROG (XS YS)
	(SETQ YS (MAPCAR (FUNCTION (LAMBDA (POINT) (GET POINT (QUOTE IMAGE)))) (GET POLYGON (QUOTE CORNERS))))
	(SETQ XS (MAPCAR (FUNCTION CAR) YS))
	(SETQ YS (MAPCAR (FUNCTION CADR) YS))
	(PUTPROP POLYGON (LEAST XS) (QUOTE XLOW))
	(PUTPROP POLYGON (LEAST YS) (QUOTE YLOW))
	(PUTPROP POLYGON (MOST XS) (QUOTE XHIGH))
	(PUTPROP POLYGON (MOST YS) (QUOTE YHIGH)))) 
EXPR)

(DEFPROP ENDS-PROPERTY 
 (LAMBDA(POLYGON)
  (MAPC (FUNCTION
	 (LAMBDA(EDGE)
	  (PROG (A B)
		(SETQ A (GET EDGE (QUOTE POINTS)))
		(SETQ B (GET (CAR A) (QUOTE IMAGE)))
		(SETQ A (GET (CDR A) (QUOTE IMAGE)))
		(PUTPROP EDGE
			 (CONS (CONS (PLUS (CAR B) 0.0) (PLUS (CADR B) 0.0))
			       (CONS (PLUS (CAR A) 0.0) (PLUS (CADR A) 0.0)))
			 (QUOTE ENDS))
		(PUTPROP EDGE NIL VIEWNAME))))
	(GET POLYGON (QUOTE EDGES)))) 
EXPR)

(DEFPROP WARNOCK 
 (LAMBDA(POLYGON-LIST SURROUNDERS-LIST XLOW XHIGH YLOW YHIGH)
  (PROG (ABOVE-LIST)
	(OUTSIDE)
	(PRINC (QUOTE A))
	(FORCE)
	(DIW-PROPERTY)
	(SURROUND)
	(HIDE)
	(ABOVE)
	(COND ((TRIVAIL) NIL)
	      ((SIMPLE?) (CLIP))
	      ((TWO-POLY-WITH-COMMON-EDGE) (CLIP))
	      ((TWO-INTERSECTING-PLANES?) (FORM-NEW-EDGE))
	      ((SMALL?) (UNRESOLVED))
	      (T (SPLITUP))))) 
EXPR)

(DEFPROP OUTSIDE 
 (LAMBDA NIL
  (SETQ POLYGON-LIST
	(MAPPENDCAR (FUNCTION
		     (LAMBDA(POLYGON)
		      (COND
		       ((OR (GREATERP XLOW (GET POLYGON (QUOTE XHIGH)))
			    (GREATERP YLOW (GET POLYGON (QUOTE YHIGH)))
			    (LESSP XHIGH (GET POLYGON (QUOTE XLOW)))
			    (LESSP YHIGH (GET POLYGON (QUOTE YLOW))))
			NIL)
		       (T (NCONS POLYGON)))))
 		    POLYGON-LIST))) 
EXPR)

(DEFPROP MAPPENDCAR 
 (LAMBDA (FN L) (COND ((NULL L) NIL) (T (APPEND (FN (CAR L)) (MAPPENDCAR FN (CDR L)))))) 
EXPR)

(DEFPROP MAPPENDLIST 
 (LAMBDA (FN L) (COND ((NULL L) NIL) (T (APPEND (FN L) (MAPPENDLIST FN (CDR L)))))) 
EXPR)

(DEFPROP DIW-PROPERTY 
 (LAMBDA NIL
  (MAPC (FUNCTION
	 (LAMBDA(POLYGON)
	  (PUTPROP POLYGON
		   (EXTREMA
		    (LIST (ZDEPTH XLOW YLOW) (ZDEPTH XHIGH YLOW) (ZDEPTH XHIGH YHIGH) (ZDEPTH XLOW YHIGH)))
		   (QUOTE DIW))))
	(APPEND POLYGON-LIST SURROUNDERS-LIST))) 
EXPR)

(DEFPROP EXTREMA 
 (LAMBDA (LIST-OF-NUMBERS) (CONS (LEAST LIST-OF-NUMBERS) (MOST LIST-OF-NUMBERS))) 
EXPR)

(DEFPROP MOST 
 (LAMBDA (Z) (*MOST -77777777777 Z)) 
EXPR)

(DEFPROP *MOST 
 (LAMBDA(MAX Z)
  (COND ((NULL Z) MAX) ((GREATERP (CAR Z) MAX) (*MOST (CAR Z) (CDR Z))) (T (*MOST MAX (CDR Z))))) 
EXPR)

(DEFPROP LEAST 
 (LAMBDA (Z) (*LEAST 77777777777 Z)) 
EXPR)

(DEFPROP *LEAST 
 (LAMBDA (MIN Z) (COND ((NULL Z) MIN) ((LESSP (CAR Z) MIN) (*LEAST (CAR Z) (CDR Z))) (T (*LEAST MIN (CDR Z))))) 
EXPR)

(DEFPROP ZDEPTH 
 (LAMBDA(X Y)
  (QUOTIENT (DIFFERENCE 100.0 (TIMES (GET POLYGON (QUOTE A)) X) (TIMES (GET POLYGON (QUOTE B)) Y))
	    (GET POLYGON (QUOTE C)))) 
EXPR)

(DEFPROP SURROUND 
 (LAMBDA NIL
  (SETQ POLYGON-LIST
	(MAPPENDCAR (FUNCTION
		     (LAMBDA(POLYGON)
		      (COND ((SURROUNDS-WINDOW? POLYGON) (SETQ SURROUNDERS-LIST
							       (CONS POLYGON SURROUNDERS-LIST))
 							 NIL)
			    (T (NCONS POLYGON)))))
 		    POLYGON-LIST))) 
EXPR)

(DEFPROP SURROUNDS-WINDOW? 
 (LAMBDA(POLYGON)
  (AND (IS-WINDOW-SURROUNDED-BY-CIRCUMSCRIBED-RECTANGLE?) (IS-EACH-CORNER-OF-WINDOW-WITHIN-THE-POLYGON?))) 
EXPR)

(DEFPROP IS-WINDOW-SURROUNDED-BY-CIRCUMSCRIBED-RECTANGLE? 
 (LAMBDA NIL
  (AND (GREATERP (GET POLYGON (QUOTE XHIGH)) XHIGH)
       (GREATERP (GET POLYGON (QUOTE YHIGH)) YHIGH)
       (LESSP (GET POLYGON (QUOTE XLOW)) XLOW)
       (LESSP (GET POLYGON (QUOTE YLOW)) YLOW))) 
EXPR)

(DEFPROP IS-EACH-CORNER-OF-WINDOW-WITHIN-THE-POLYGON? 
 (LAMBDA NIL
  (PROG (TRIANGLE-LIST)
	(SPLIT-POLYGON-INTO-TRIANGLES)
	(RETURN
	 (AND (CORNER-WITHIN-ANY-TRIANGLE? TRIANGLE-LIST XLOW YLOW)
	      (CORNER-WITHIN-ANY-TRIANGLE? TRIANGLE-LIST XLOW YHIGH)
	      (CORNER-WITHIN-ANY-TRIANGLE? TRIANGLE-LIST XHIGH YLOW)
	      (CORNER-WITHIN-ANY-TRIANGLE? TRIANGLE-LIST XHIGH YHIGH))))) 
EXPR)

(DEFPROP SPLIT-POLYGON-INTO-TRIANGLES 
 (LAMBDA NIL
  (SETQ TRIANGLE-LIST
	(MAPPENDLIST (FUNCTION
		      (LAMBDA(LIST-OF-CORNERS)
		       (COND ((GREATERP 3 (LENGTH LIST-OF-CORNERS)) NIL)
			     (T
			      (NCONS
			       (CONS (CAR LIST-OF-CORNERS)
				     (CONS (CADR LIST-OF-CORNERS) (LAST LIST-OF-CORNERS))))))))
		     (MAPCAR (FUNCTION (LAMBDA (CORNER) (GET CORNER (QUOTE IMAGE))))
			     (GET POLYGON (QUOTE CORNERS)))))) 
EXPR)

(DEFPROP CORNER-WITHIN-ANY-TRIANGLE? 
 (LAMBDA(TRIANGLE-LIST X Y)
  (COND ((NULL TRIANGLE-LIST) NIL)
	((CORNER-WITHIN-TRIANGLE? (CAR TRIANGLE-LIST)) T)
	(T (CORNER-WITHIN-ANY-TRIANGLE? (CDR TRIANGLE-LIST) X Y)))) 
EXPR)

(DEFPROP CORNER-WITHIN-TRIANGLE? 
 (LAMBDA(TRIANGLE)
  (AND (POINT-AND-ODD-VERTEX-IN-SAME-HALF-PLANE? TRIANGLE)
       (POINT-AND-ODD-VERTEX-IN-SAME-HALF-PLANE? (REVERSE TRIANGLE))
       (POINT-AND-ODD-VERTEX-IN-SAME-HALF-PLANE? (APPEND (CDR TRIANGLE) (NCONS (CAR TRIANGLE)))))) 
EXPR)

(DEFPROP POINT-AND-ODD-VERTEX-IN-SAME-HALF-PLANE? 
 (LAMBDA(TRIANGLE)
  (NOT (MINUSP (TIMES (MMMM X Y (CDR TRIANGLE)) (MMMM (CAAR TRIANGLE) (CADAR TRIANGLE) (CDR TRIANGLE)))))) 
EXPR)

(DEFPROP MMMM 
 (LAMBDA (X Y Z) (MMM X (CAAR Z) (CAADR Z) Y (CADAR Z) (CADADR Z))) 
EXPR)

(DEFPROP MMM 
 (LAMBDA(X1 X2 X3 Y1 Y2 Y3)
  (DIFFERENCE (TIMES (DIFFERENCE Y2 Y1 0.0) (DIFFERENCE X2 X3))
	      (TIMES (DIFFERENCE X2 X1 0.0) (DIFFERENCE Y2 Y3)))) 
EXPR)

(DEFPROP HIDE 
 (LAMBDA NIL
  (PROG (DEPTH-BOUND)
	(SETQ DEPTH-BOUND
	      (LEAST
	       (MAPCAR (FUNCTION CDR)
		       (MAPCAR (FUNCTION (LAMBDA (SURROUNDER) (GET SURROUNDER (QUOTE DIW))))
 			       SURROUNDERS-LIST))))
	(SETQ SURROUNDERS-LIST (MAPPENDCAR (FUNCTION NIL-BEYOND-DEPTH-BOUND) SURROUNDERS-LIST))
	(SETQ POLYGON-LIST (MAPPENDCAR (FUNCTION NIL-BEYOND-DEPTH-BOUND) POLYGON-LIST)))) 
EXPR)

(DEFPROP NIL-BEYOND-DEPTH-BOUND 
 (LAMBDA (POLYGON) (COND ((LESSP DEPTH-BOUND (CAR (GET POLYGON (QUOTE DIW)))) NIL) (T (NCONS POLYGON)))) 
EXPR)

(DEFPROP ABOVE 
 (LAMBDA NIL
  (PROG (DEPTH-BOUND)
	(SETQ DEPTH-BOUND
	      (LEAST
	       (MAPCAR (FUNCTION CAR)
		       (MAPCAR (FUNCTION (LAMBDA (SURROUNDER) (GET SURROUNDER (QUOTE DIW))))
 			       SURROUNDERS-LIST))))
	(SETQ ABOVE-LIST
	      (MAPPENDCAR (FUNCTION
			   (LAMBDA(POLYGON)
			    (COND
			     ((LESSP (CDR (GET POLYGON (QUOTE DIW))) DEPTH-BOUND) (NCONS POLYGON))
			     (T NIL))))
 			  POLYGON-LIST)))) 
EXPR)

(DEFPROP CLIP 
 (LAMBDA NIL
  (MAPC (FUNCTION
	 (LAMBDA(EDGE)
	  (PUTPROP EDGE (XXXXXX (CLIP-LINE-SEGMENT (GET EDGE (QUOTE ENDS))) (GET EDGE VIEWNAME)) VIEWNAME)))
	(GET (CAR POLYGON-LIST) (QUOTE EDGES)))) 
EXPR)

(DEFPROP CLIP2 
 (LAMBDA NIL
  (MAPC (FUNCTION
	 (LAMBDA(EDGE)
	  (PUTPROP EDGE (XXXXXX (CLIP-LINE-SEGMENT (GET EDGE (QUOTE ENDS))) (GET EDGE VIEWNAME)) VIEWNAME)))
	(GET (CAR POLYGON-LIST) (QUOTE EDGEZ)))) 
EXPR)

(DEFPROP SPLICE1 
 (LAMBDA(LINE LINE-LIST)
  (COND ((NULL LINE) LINE-LIST)
	((NULL LINE-LIST) (LIST LINE))
	((SAMEPOINT? (CAR LINE) (CAAR LINE-LIST)) (SPLICE1 (CONS (CDR LINE) (CDAR LINE-LIST)) (CDR LINE-LIST)))
	((SAMEPOINT? (CAR LINE) (CDAR LINE-LIST)) (SPLICE1 (CONS (CDR LINE) (CAAR LINE-LIST)) (CDR LINE-LIST)))
	((SAMEPOINT? (CDR LINE) (CAAR LINE-LIST)) (SPLICE1 (CONS (CAR LINE) (CDAR LINE-LIST)) (CDR LINE-LIST)))
	((SAMEPOINT? (CDR LINE) (CDAR LINE-LIST)) (SPLICE1 (CONS (CAR LINE) (CAAR LINE-LIST)) (CDR LINE-LIST)))
	(T (CONS (CAR LINE-LIST) (SPLICE1 LINE (CDR LINE-LIST)))))) 
EXPR)

(DEFPROP SPLICE2 
 (LAMBDA(LINE LINE-LIST)
  (COND ((NULL LINE) LINE-LIST)
	((NULL LINE-LIST) (LIST LINE))
	((EQUAL (CAR LINE) (CAAR LINE-LIST)) (SPLICE2 (CONS (CDR LINE) (CDAR LINE-LIST)) (CDR LINE-LIST)))
	((EQUAL (CAR LINE) (CDAR LINE-LIST)) (SPLICE2 (CONS (CDR LINE) (CAAR LINE-LIST)) (CDR LINE-LIST)))
	((EQUAL (CDR LINE) (CAAR LINE-LIST)) (SPLICE2 (CONS (CAR LINE) (CDAR LINE-LIST)) (CDR LINE-LIST)))
	((EQUAL (CDR LINE) (CDAR LINE-LIST)) (SPLICE2 (CONS (CAR LINE) (CAAR LINE-LIST)) (CDR LINE-LIST)))
	(T (CONS (CAR LINE-LIST) (SPLICE2 LINE (CDR LINE-LIST)))))) 
EXPR)

(DEFPROP SUPERSPLICE1 
 (LAMBDA(POLY)
  (MAPC (FUNCTION
	 (LAMBDA(EDGE)
	  (PROG (A B)
		(SETQ A (MAPCAR (FUNCTION ORDLOW) (ONCEONLY (GET EDGE VIEWNAME))))
		(SET B NIL)
 	   L    (COND ((NULL A) (RETURN (PUTPROP EDGE B VIEWNAME))))
		(SETQ B (SPLICE1 (CAR A) B))
		(SETQ A (CDR A))
		(GO L))))
	(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES))))) 
EXPR)

(DEFPROP SUPERSPLICE2 
 (LAMBDA(POLY)
  (MAPC (FUNCTION
	 (LAMBDA(EDGE)
	  (PROG (A B)
		(SETQ A (MAPCAR (FUNCTION ORDLOW) (ONCEONLY (GET EDGE VIEWNAME))))
		(SET B NIL)
 	   L    (COND ((NULL A) (RETURN (PUTPROP EDGE B VIEWNAME))))
		(SETQ B (SPLICE2 (CAR A) B))
		(SETQ A (CDR A))
		(GO L))))
	(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES))))) 
EXPR)

(DEFPROP SAMEPOINT? 
 (LAMBDA(A B)
  (AND (GREATERP 1.0 (ABS (DIFFERENCE (CAR A) (CAR B)))) (GREATERP 1.0 (ABS (DIFFERENCE (CDR A) (CDR B)))))) 
EXPR)

(DEFPROP CLIP-LINE-SEGMENT 
 (LAMBDA(LINE)
  (COND ((ENDPOINTS-WITHIN-WINDOW?) LINE)
	((ENDPOINTS-BEYOND-WINDOW?) NIL)
	((SAMEPOINT? (CAR LINE) (CDR LINE)) NIL)
	(T
	 (CHEAP-SPLICE (CLIP-LINE-SEGMENT (CONS (CAR LINE) (MIDPOINT LINE)))
		       (CLIP-LINE-SEGMENT (CONS (MIDPOINT LINE) (CDR LINE))))))) 
EXPR)

(DEFPROP ENDPOINTS-WITHIN-WINDOW? 
 (LAMBDA NIL
  (AND (GREATERPEQ XHIGH (CAAR LINE) XLOW)
       (GREATERPEQ XHIGH (CADR LINE) XLOW)
       (GREATERPEQ YHIGH (CDAR LINE) YLOW)
       (GREATERPEQ YHIGH (CDDR LINE) YLOW))) 
EXPR)

(DEFPROP ENDPOINTS-BEYOND-WINDOW? 
 (LAMBDA NIL
  (OR (AND (GREATERP (CAAR LINE) XHIGH) (GREATERP (CADR LINE) XHIGH))
      (AND (GREATERP (CDAR LINE) YHIGH) (GREATERP (CDDR LINE) YHIGH))
      (AND (LESSP (CAAR LINE) XLOW) (LESSP (CADR LINE) XLOW))
      (AND (LESSP (CDAR LINE) YLOW) (LESSP (CDDR LINE) YLOW)))) 
EXPR)

(DEFPROP GREATERPEQ 
 (LAMBDA (A B C) (OR (GREATERP A B C) (EQUAL A B) (EQUAL B C))) 
EXPR)

(DEFPROP CHEAP-SPLICE 
 (LAMBDA (A B) (COND ((NULL A) B) ((NULL B) A) (T (CONS (CAR A) (CDR B))))) 
EXPR)

(DEFPROP MIDPOINT 
 (LAMBDA (LINE) (CONS (QUOTIENT (PLUS (CAAR LINE) (CADR LINE)) 2) (QUOTIENT (PLUS (CDAR LINE) (CDDR LINE)) 2))) 
EXPR)

(DEFPROP TRIVAIL 
 (LAMBDA NIL (AND (NULL POLYGON-LIST) (GREATERP 2 (LENGTH SURROUNDERS-LIST)))) 
EXPR)

(DEFPROP SIMPLE? 
 (LAMBDA NIL
  (AND (GREATERP 2 (LENGTH ABOVE-LIST))
       (GREATERP 2 (LENGTH SURROUNDERS-LIST))
       (EQUAL ABOVE-LIST POLYGON-LIST))) 
EXPR)

(DEFPROP SMALL? 
 (LAMBDA NIL (GREATERP 1 (DIFFERENCE XHIGH XLOW))) 
EXPR)

(DEFPROP UNRESOLVED 
 (LAMBDA NIL
  (COND ((NULL POLYGON-LIST) (SETQ INTER (CONS (CONS XLOW YLOW) INTER)))
	(T (SETQ UNRES (CONS (CONS XLOW YLOW) UNRES))))) 
EXPR)

(DEFPROP SPLITUP 
 (LAMBDA NIL
  (PROG (MX MY)
	(SETQ MX (QUOTIENT (PLUS XLOW XHIGH) 2))
	(SETQ MY (QUOTIENT (PLUS YLOW YHIGH) 2))
	(WARNOCK POLYGON-LIST SURROUNDERS-LIST MX XHIGH MY YHIGH)
	(WARNOCK POLYGON-LIST SURROUNDERS-LIST XLOW MX MY YHIGH)
	(WARNOCK POLYGON-LIST SURROUNDERS-LIST XLOW MX YLOW MY)
	(WARNOCK POLYGON-LIST SURROUNDERS-LIST MX XHIGH YLOW MY))) 
EXPR)

(DEFPROP SAFE 
 (LAMBDA NIL (DSKOUT HIDDEN (GRINL ALLFNS))) 
EXPR)

(DEFPROP TEST2 
 (LAMBDA NIL
  (PROG NIL
	(DATA)
	(INITPOLY (QUOTE RR1))
	(INITPOLY (QUOTE RR2))
	(WARNOCK (QUOTE (RR1 RR2)) NIL -512.0 512.0 -512.0 512.0)
	(SUPERSPLICE2 (QUOTE RR1))
	(SUPERSPLICE2 (QUOTE RR2))
	(SUPERSPLICE1 (QUOTE RR1))
	(SUPERSPLICE1 (QUOTE RR2))
	(LINELENGTH 77777)
	(III (QUOTE RR1))
	(III (QUOTE RR2))
	(LINELENGTH 105))) 
EXPR)